home *** CD-ROM | disk | FTP | other *** search
- (*===========================================================================*)
- (* Task switcher *)
- (* *)
- (* Copyright 1988, 1989, 1990, 1991, 1992 by H. Roy Engehausen. All *)
- (* rights reserved. *)
- (* *)
- (*===========================================================================*)
-
- UNIT BBTASK;
-
- INTERFACE
-
- USES
- bbdummy;
-
- FUNCTION task_create(ic : POINTER; stack_size : WORD) : tcb_ptr;
- PROCEDURE tcb_init(this_tcb : tcb_ptr);
- PROCEDURE task_switch;
- PROCEDURE task_destroy(kill_tcb : tcb_ptr);
- PROCEDURE task_destroy_active;
- PROCEDURE task_free(this_tcb : tcb_ptr);
- FUNCTION task_is_dead(this_tcb : tcb_ptr) : BOOLEAN;
-
- TYPE
- task_array_element = RECORD
- element_stack_size : WORD;
- element_tcb_ptr : tcb_ptr;
- END;
-
- task_array = ARRAY[1..500] OF task_array_element;
-
- VAR
- system_startup : BOOLEAN;
- task_array_ptr : ^task_array;
-
- IMPLEMENTATION
-
- USES
- CRT,
- DOS,
- bbbug,
- bbconvm,
- bbdump,
- bbmem,
- bbsema2,
- bbstack,
- bbover,
- bbwin;
-
- (*===========================================================================*)
- (* Debugging control *)
- (*===========================================================================*)
-
- {$UNDEF taskdebug}
- {$UNDEF stckdebug}
- {$UNDEF taskalbug}
- {$UNDEF fwdkdebug}
-
- (*===========================================================================*)
- (* Common types and variables *)
- (*===========================================================================*)
-
- VAR
- set_bp : WORD;
- set_sp : WORD;
- set_ss : WORD;
- task_start_place : POINTER;
-
- (*===========================================================================*)
- (* Forward calls to routines in here *)
- (*===========================================================================*)
-
- PROCEDURE task_start; FORWARD;
- PROCEDURE tcb_drop(this_tcb : tcb_ptr); FORWARD;
-
- (*===========================================================================*)
- (* Create a new task *)
- (*===========================================================================*)
-
- FUNCTION task_create(ic : POINTER; stack_size : WORD) : tcb_ptr;
-
- VAR
- i : BYTE;
- j : INTEGER;
- this_one : BYTE;
- maybe_this : BYTE;
- new_tcb : tcb_ptr;
- maybe : BYTE;
- stack_place : POINTER;
-
- BEGIN;
-
- {$IFDEF taskalbug}
- WRITELN('Get task = ', stack_size);
- DELAY(1000);
- {$ENDIF}
-
- (*---------------------------------------------------------------------*)
- (* Find an unused TCB *)
- (*---------------------------------------------------------------------*)
-
- i := 0;
- this_one := 0;
- maybe_this := 0;
-
- IF NOT system_startup THEN
- WHILE (i < opt_block.max_task_no) AND (this_one = 0) DO
- BEGIN;
- INC(i);
-
- {$IFDEF taskalbug}
- WITH task_array_ptr^[i] DO
- WRITELN('Get task look -- ', element_tcb_ptr^.tcb_dead, ' / ',
- element_stack_size);
- {$ENDIF}
-
- WITH task_array_ptr^[i] DO
- IF (element_tcb_ptr^.tcb_dead) THEN
- BEGIN;
-
- {$IFDEF taskalbug}
- WRITELN(' El = ', element_stack_size,
- ' SS = ', stack_size);
- {$ENDIF}
-
- j := element_stack_size - INTEGER(stack_size);
- IF j = 0 THEN
- this_one := i;
- IF j > 0 THEN
- maybe_this := i;
- END;
-
- END;
-
- IF this_one = 0 THEN
- this_one := maybe_this;
-
- {$IFDEF taskalbug}
- WRITELN('Get task found? -- ', this_one , ' / ', i);
- DELAY(1000);
- {$ENDIF}
-
- (*-----------------------------------------------------------------------*)
- (* Use the one we found or build one if necessary *)
- (*-----------------------------------------------------------------------*)
-
- IF this_one > 0 THEN
- new_tcb := task_array_ptr^[this_one].element_tcb_ptr
- ELSE
- BEGIN;
-
- (*-------------------------------------------------------------------*)
- (* Get the stack *)
- (*-------------------------------------------------------------------*)
-
- IF MAXAVAIL >= stack_size THEN
- BEGIN;
- GETMEM(stack_place, stack_size);
- FILLCHAR(stack_place^, stack_size, 0);
- END
- ELSE
- BEGIN;
- window_write_critical('', 'TK:: No room for stack');
- task_create := NIL;
- EXIT;
- END;
-
- (*-------------------------------------------------------------------*)
- (* Get the tcb *)
- (*-------------------------------------------------------------------*)
-
- IF MAXAVAIL >= SIZEOF(tcb) THEN
- NEW(new_tcb)
- ELSE
- BEGIN;
- FREEMEM(stack_place, stack_size);
- window_write_critical('', 'TK:: No room for tcb');
- task_create := NIL;
- EXIT;
- END;
-
- (*-------------------------------------------------------------------*)
- (* Add stack info to TCB *)
- (*-------------------------------------------------------------------*)
-
- new_tcb^.sseg_init := SEG(stack_place^);
- new_tcb^.sseg_bot := OFS(stack_place^);
- new_tcb^.sptr_init := OFS(stack_place^) + stack_size - 16;
- new_tcb^.sseg_size := stack_size;
-
- {$IFDEF stckdebug}
- WRITELN('Get');
- WITH new_tcb^ DO
- BEGIN;
- WRITELN('Stack -- ', pw2x(sseg_init, sptr_init));
- WRITELN('Size = ', sseg_size);
- END;
- {$ENDIF}
-
- END;
-
- (*-----------------------------------------------------------------------*)
- (* Add to the chain and count it! It must be the next TCB in the chain *)
- (*-----------------------------------------------------------------------*)
-
- new_tcb^.next_tcb := active_tcb^.next_tcb;
- active_tcb^.next_tcb := new_tcb;
-
- INC(alive_tcb_count);
-
- status_window_change := TRUE;
-
- (*-----------------------------------------------------------------------*)
- (* Initialize it *)
- (*-----------------------------------------------------------------------*)
-
- tcb_init(new_tcb);
-
- (*-----------------------------------------------------------------------*)
- (* Switch to new task *)
- (*-----------------------------------------------------------------------*)
-
- task_start_place := ic;
- task_start;
-
- task_create := new_tcb;
-
- END;
-
- (*===========================================================================*)
- (* Destroy a task *)
- (*===========================================================================*)
-
- PROCEDURE task_destroy(kill_tcb : tcb_ptr);
-
- VAR
- b : BOOLEAN;
- work_tcb : tcb_ptr;
-
- BEGIN;
-
- (*-----------------------------------------------------------------------*)
- (* Verify we are killing the right task *)
- (*-----------------------------------------------------------------------*)
-
- IF kill_tcb^.tcb_number <= overhead_tcb_count THEN
- BEGIN;
- WRITELN('Attempt to kill overhead task');
- dump_all;
- HALT;
- END;
-
- (*-----------------------------------------------------------------------*)
- (* Find this task's predecessor and drop killed TCB from chain *)
- (*-----------------------------------------------------------------------*)
-
- work_tcb := ring_tcb;
-
- b := FALSE;
- REPEAT
- b := work_tcb^.next_tcb = kill_tcb;
- IF b THEN
- work_tcb^.next_tcb := kill_tcb^.next_tcb
- ELSE
- work_tcb := work_tcb^.next_tcb;
- UNTIL b;
-
- (*-----------------------------------------------------------------------*)
- (* Drop killed TCB *)
- (*-----------------------------------------------------------------------*)
-
- DEC(alive_tcb_count);
-
- status_window_change := TRUE;
-
- (*-----------------------------------------------------------------------*)
- (* Clean up *)
- (*-----------------------------------------------------------------------*)
-
- tcb_drop(kill_tcb);
-
- (*-----------------------------------------------------------------------*)
- (* If no stack to free, mark as dead and we are done *)
- (*-----------------------------------------------------------------------*)
-
- IF kill_tcb^.sseg_size = 0 THEN
- BEGIN;
- kill_tcb^.tcb_dead := TRUE;
- EXIT;
- END;
-
- (*-----------------------------------------------------------------------*)
- (* If not active then delete it *)
- (*-----------------------------------------------------------------------*)
-
- IF active_tcb <> kill_tcb THEN
- task_free(kill_tcb);
-
- END;
-
- (*===========================================================================*)
- (* Destroy the active task *)
- (*===========================================================================*)
-
- PROCEDURE task_destroy_active;
-
- BEGIN;
-
- (*------------------------------------------------------------------------*)
- (* Kill the active TCB *)
- (*------------------------------------------------------------------------*)
-
- task_destroy(active_tcb);
-
- (*-----------------------------------------------------------------------*)
- (* If we are now dead, then we are done. TASK_SWITCH will never return *)
- (*-----------------------------------------------------------------------*)
-
- IF active_tcb^.tcb_dead THEN
- task_switch;
-
- (*-----------------------------------------------------------------------*)
- (* Next task is main *)
- (*-----------------------------------------------------------------------*)
-
- main_switch := TRUE;
-
- (*-----------------------------------------------------------------------*)
- (* Add to kill list *)
- (*-----------------------------------------------------------------------*)
-
- active_tcb^.next_tcb := dead_tcb_list;
- dead_tcb_list := active_tcb;
-
- (*-----------------------------------------------------------------------*)
- (* Switch away, never to return! *)
- (*-----------------------------------------------------------------------*)
-
- task_switch;
-
- END;
-
- (*===========================================================================*)
- (* Initialize a TCB *)
- (*===========================================================================*)
-
- PROCEDURE tcb_init(this_tcb : tcb_ptr);
-
- VAR
- b : BOOLEAN;
- buff_size : WORD;
- i : BYTE;
- look_tcb : tcb_ptr;
-
- BEGIN;
-
- WITH this_tcb^ DO
- BEGIN;
-
- (*-------------------------------------------------------------------*)
- (* Clear tcb name *)
- (*-------------------------------------------------------------------*)
-
- tcb_name := '';
-
- (*-------------------------------------------------------------------*)
- (* Get a unique number *)
- (*-------------------------------------------------------------------*)
-
- IF sseg_size <> 0 THEN
- BEGIN;
- i := 2;
- b := FALSE;
-
- REPEAT
-
- look_tcb := ring_tcb;
- REPEAT
- look_tcb := look_tcb^.next_tcb;
- UNTIL (look_tcb = ring_tcb) OR (look_tcb^.tcb_number = i);
-
- IF look_tcb^.tcb_number = i THEN
- INC(i)
- ELSE
- b := TRUE;
-
- UNTIL b;
-
- tcb_number := i;
- END;
-
- channel := active_tcb^.channel;
- tcb_port := active_port;
-
- buff_size := 651;
- w_color := default_data_color;
-
- IF active_port <> NIL THEN
- WITH active_port^ DO
- BEGIN;
-
- port_chan_s := port_char + byte_to_char[channel];
-
- CASE port_type OF
- port_g8bpq, port_aeapk232:
- ;
- port_bpqhost:
- buff_size := opt_block.bpq_buff;
- ELSE
- BEGIN;
- IF SIZEOF(host_to_tnc) > SIZEOF(tnc_to_host) THEN
- buff_size := SIZEOF(host_to_tnc)
- ELSE
- buff_size := SIZEOF(tnc_to_host);
- END;
- END;
-
- w_color := port_color;
- END;
-
- tcb_ovr_cnt := 0;
-
- GETMEM(tnc_htt, buff_size);
-
- tnc_tth := @tnc_htt^;
- tnc_b_size := buff_size;
-
- FILLCHAR(tnc_htt^, tnc_b_size, 0);
-
- FILLCHAR(tcb_transmit_idle,
- SIZEOF(tcb_bid_level) + OFS(tcb_bid_level) - OFS(tcb_transmit_idle),
- 0);
-
- io_fe := NIL;
- path_fe := NIL;
-
- FILLCHAR(uid_data, SIZEOF(uid_data), CHR(0));
- uid_data.user_i_ptr := NIL;
-
- FILLCHAR(curr_msg, SIZEOF(curr_msg), CHR(0));
-
- curr_fwd.msg_p_i := NIL;
-
- window := 0;
-
- tnc_data := active_tcb^.tnc_data;
- tnc_in_chn := NIL;
-
- i_data.long_length := 0;
- i_data.str_data := '';
- o_data.long_length := 0;
- o_data.str_data := '';
- stor_list := NIL;
-
- c_input := NIL;
- conv_tcb := NIL;
-
- stack_cnt := 0;
- stack_usage := sptr_init;
-
- FILLCHAR(tcb_access_mode, SIZEOF(tcb_access_mode), CHR(0));
-
- END;
-
- END;
-
- (*===========================================================================*)
- (* Free a process's resources *)
- (*===========================================================================*)
-
- PROCEDURE tcb_drop(this_tcb : tcb_ptr);
- VAR
- b : BOOLEAN;
- i : INTEGER;
- last_scb : str_chain_ptr;
- next_m_chain : str_m_chain;
- next_mem : mem_list_ptr;
- port_test : port_block_ptr;
- size : LONGINT;
- this_mem : mem_list_ptr;
- work_scb : str_chain_ptr;
- work_m_chain : str_m_chain;
- work_tcb : tcb_ptr;
-
- BEGIN;
-
- (*-----------------------------------------------------------------------*)
- (* Drop from connected list *)
- (*-----------------------------------------------------------------------*)
-
- port_test := this_tcb^.tcb_port;
-
- IF port_test <> NIL THEN
- REPEAT
-
- FOR i := 0 TO port_test^.max_chan DO
- IF port_test^.connected^[i] = this_tcb THEN
- port_test^.connected^[i] := NIL;
-
- port_test := port_test^.next_port;
-
- UNTIL port_test = this_tcb^.tcb_port;
-
- (*-----------------------------------------------------------------------*)
- (* Free the TNC buffer *)
- (*-----------------------------------------------------------------------*)
-
- IF this_tcb^.tnc_htt <> NIL THEN
- FREEMEM(this_tcb^.tnc_htt, this_tcb^.tnc_b_size);
-
- (*-----------------------------------------------------------------------*)
- (* Free chained input buffers *)
- (*-----------------------------------------------------------------------*)
-
- next_m_chain := this_tcb^.tnc_in_chn;
- WHILE next_m_chain <> NIL DO
- BEGIN;
- work_m_chain := next_m_chain;
- next_m_chain := work_m_chain^.str_m_next;
- FREEMEM(work_m_chain, 3 + 6 + work_m_chain^.str_m_data.long_length);
- END;
-
- (*-----------------------------------------------------------------------*)
- (* Free random storage *)
- (*-----------------------------------------------------------------------*)
-
- IF this_tcb^.stor_list <> NIL THEN
- BEGIN;
-
- this_mem := this_tcb^.stor_list;
-
- REPEAT
-
- next_mem := this_mem^.next_mem_list;
- size := LONGINT(mem_overhead) + this_mem^.mem_size;
-
- FREEMEM(this_mem, size);
-
- this_mem := next_mem;
-
- UNTIL this_mem = NIL;
-
- END;
-
- (*-----------------------------------------------------------------------*)
- (* Free conversational input chain *)
- (*-----------------------------------------------------------------------*)
-
- WHILE this_tcb^.c_input <> NIL DO
- del_c_string(this_tcb);
-
- (*-----------------------------------------------------------------------*)
- (* Remove this tcb from conversational chain *)
- (*-----------------------------------------------------------------------*)
-
- drop_conv(this_tcb);
-
- (*-----------------------------------------------------------------------*)
- (* Free file element *)
- (*-----------------------------------------------------------------------*)
-
- IF this_tcb^.io_fe <> NIL THEN
- WITH this_tcb^.io_fe^ DO
- BEGIN;
-
- IF NOT fe_type THEN
- BEGIN;
- {$I-}
- CLOSE(fe_text);
- i := IORESULT;
- {$I+}
- END
- ELSE
- BEGIN;
- {$I-}
- CLOSE(fe_text);
- i := IORESULT;
- {$I+}
- END;
-
- DISPOSE(this_tcb^.io_fe);
- this_tcb^.io_fe := NIL;
-
- END;
-
- (*-----------------------------------------------------------------------*)
- (* Free path file element *)
- (*-----------------------------------------------------------------------*)
-
- IF this_tcb^.path_fe <> NIL THEN
- BEGIN;
- WITH this_tcb^.path_fe^ DO
- BEGIN;
-
- IF NOT fe_type THEN
- BEGIN;
- {$I-}
- CLOSE(fe_text);
- i := IORESULT;
- {$I+}
- END
- ELSE
- BEGIN;
- {$I-}
- CLOSE(fe_text);
- i := IORESULT;
- {$I+}
- END;
-
- END;
-
- DISPOSE(this_tcb^.path_fe);
- this_tcb^.path_fe := NIL;
-
- END;
-
- (*-----------------------------------------------------------------------*)
- (* Mark message as not forward in progress *)
- (*-----------------------------------------------------------------------*)
-
- IF this_tcb^.curr_fwd.msg_p_i <> NIL THEN
- WITH this_tcb^.curr_fwd, this_tcb^.curr_fwd.msg_p_i^ DO
- BEGIN;
- {$IFDEF fwdkdebug}
- WRITELN('task unselect msg -- ', msg_i_mb^.msg_number);
- {$ENDIF}
- b := FALSE;
- IF msg_p_item <> 0 THEN
- WITH msg_i_dr^.msg_dr_dblk^ DO
- BEGIN;
- WITH msg_d_array[msg_p_item] DO
- msg_d_flag := msg_d_flag AND (NOT df_fwd_process);
- FOR i := 1 TO msg_d_no DO
- b := b
- OR ((msg_d_array[i].msg_d_flag AND df_fwd_process) <> 0);
- END;
- IF NOT b THEN
- msg_i_mb.msg_flag := msg_i_mb.msg_flag AND (NOT mf_fwd_process);
- END;
-
- (*-----------------------------------------------------------------------*)
- (* Stack display *)
- (*-----------------------------------------------------------------------*)
-
- stack_record(this_tcb);
-
- (*-----------------------------------------------------------------------*)
- (* Free all semaphores *)
- (*-----------------------------------------------------------------------*)
-
- process_free_semaphore(this_tcb);
-
- END;
-
- (*===========================================================================*)
- (* Free the last of a task's memory *)
- (*===========================================================================*)
-
- PROCEDURE task_free(this_tcb : tcb_ptr);
-
- VAR
- p : POINTER;
-
- BEGIN;
-
- {$IFDEF stckdebug}
- WRITELN('Free');
- WITH this_tcb^ DO
- BEGIN;
- WRITELN('Stack -- ', pw2x(this_tcb^.sseg_init, this_tcb^.sptr_init));
- WRITELN('Size = ', sseg_size);
- END;
- {$ENDIF}
-
- (*-----------------------------------------------------------------------*)
- (* Free stack *)
- (*-----------------------------------------------------------------------*)
-
- p := PTR(this_tcb^.sseg_init, this_tcb^.sseg_bot);
- FREEMEM(p, this_tcb^.sseg_size);
-
- (*-----------------------------------------------------------------------*)
- (* Drop TCB *)
- (*-----------------------------------------------------------------------*)
-
- DISPOSE(this_tcb);
-
- END;
-
- (*===========================================================================*)
- (* See if a task is dead *)
- (*===========================================================================*)
-
- FUNCTION task_is_dead(this_tcb : tcb_ptr) : BOOLEAN;
-
- VAR
- work_tcb : tcb_ptr;
-
- BEGIN;
-
- (*------------------------------------------------------------------------*)
- (* See if the task is in the chain *)
- (*------------------------------------------------------------------------*)
-
- work_tcb := ring_tcb;
-
- WHILE (work_tcb <> this_tcb) AND (work_tcb^.next_tcb <> ring_tcb) DO
- work_tcb := work_tcb^.next_tcb;
-
- task_is_dead := work_tcb <> this_tcb;
-
- END;
-
- (*===========================================================================*)
- (* Turn off the checks *)
- (*===========================================================================*)
-
- {$R-} {Range check off}
- {$S-} {Stack checking off}
- {$I-} {I/O checking off}
- {$V-} {String var checks off}
-
- (*===========================================================================*)
- (* This subroutine starts a task that we just created *)
- (*===========================================================================*)
-
- PROCEDURE task_start;
-
- PROCEDURE now_call_it;
-
- BEGIN;
-
- (*-----------------------------------------------------------------------*)
- (* Call the guy..... *)
- (*-----------------------------------------------------------------------*)
-
- ASM;
- CALL task_start_place
- END;
-
- END;
-
- PROCEDURE stack_setup;
- VAR
- w : ^WORD;
-
- BEGIN;
-
- w := PTR(set_ss, set_bp-8);
- FILLCHAR(w^, 16, #0);
-
- END;
-
- BEGIN;
-
- {$IFDEF taskdebug}
- WRITELN;
- WRITELN('From');
- WRITELN('STACK = ',pw2x(SSEG, SPTR));
- WRITELN('DSEG = ',w2x(DSEG));
- WRITELN('PREFIX = ',w2x(PREFIXSEG));
- WRITELN('BPTR = ',a2x(set_bp));
- {$ENDIF}
-
- (*-----------------------------------------------------------------------*)
- (* Save the old task's overlay stuff. *)
- (*-----------------------------------------------------------------------*)
-
- IF NOT active_tcb^.tcb_no_overlay THEN
- overlay_save;
-
- (*-----------------------------------------------------------------------*)
- (* Save current SS:SP and BP *)
- (*-----------------------------------------------------------------------*)
-
- ASM;
- MOV set_bp,BP
- END;
-
- WITH active_tcb^ DO
- BEGIN;
- sseg_value := SSEG;
- sptr_value := SPTR;
- bptr_value := set_bp;
- END;
-
- (*-----------------------------------------------------------------------*)
- (* Switch tasks *)
- (*-----------------------------------------------------------------------*)
-
- active_tcb := active_tcb^.next_tcb;
- active_port := active_tcb^.tcb_port;
-
- (*-----------------------------------------------------------------------*)
- (* Restore SS:SP, BP and ready stack *)
- (*-----------------------------------------------------------------------*)
-
- set_ss := active_tcb^.sseg_init;
- set_sp := active_tcb^.sptr_init;
- set_bp := active_tcb^.sptr_init;
-
- stack_setup;
-
- ASM;
- CLI
- MOV SS,set_ss
- MOV SP,set_sp
- MOV BP,set_bp
- STI
- END;
-
- (*-----------------------------------------------------------------------*)
- (* Show switch to *)
- (*-----------------------------------------------------------------------*)
-
- {$IFDEF taskdebug}
- WRITELN;
- WRITELN('To');
- WRITELN('STACK = ',pw2x(SSEG, SPTR));
- WRITELN('DSEG = ',w2x(DSEG));
- WRITELN('PREFIX = ',w2x(PREFIXSEG));
- WRITELN('BPTR = ',a2x(set_bp));
- {$ENDIF}
-
- (*-----------------------------------------------------------------------*)
- (* Call the guy..... *)
- (*-----------------------------------------------------------------------*)
-
- now_call_it;
-
- WRITELN('Impossible return!!!! -- help !!!!');
-
- HALT;
-
- END;
-
- (*===========================================================================*)
- (* Switch to next task *)
- (*===========================================================================*)
-
- PROCEDURE task_switch;
- BEGIN;
-
- (*-----------------------------------------------------------------------*)
- (* Reset window to a known place. This simulates a SELECT *)
- (*-----------------------------------------------------------------------*)
-
- IF current_window <> window_reset THEN
- BEGIN;
- current_window := window_reset;
- WINDOW( 1, window_location[window_full_screen].window_u_y,
- 80, window_location[window_full_screen].window_l_y);
-
- GOTOXY(window_array[window_reset].window_cursor, reset_window_y);
- END;
-
- (*-----------------------------------------------------------------------*)
- (* Save the old task's overlay stuff. *)
- (*-----------------------------------------------------------------------*)
-
- IF NOT active_tcb^.tcb_no_overlay THEN
- overlay_save;
-
- (*-----------------------------------------------------------------------*)
- (* Show switch from *)
- (*-----------------------------------------------------------------------*)
-
- {$IFDEF taskdebug}
- WRITELN;
- WRITELN('From');
- WRITELN('STACK = ',pw2x(SSEG, SPTR));
- WRITELN('DSEG = ',w2x(DSEG));
- WRITELN('PREFIX = ',w2x(PREFIXSEG));
- WRITELN('BPTR = ',a2x(set_bp));
- {$ENDIF}
-
- (*-----------------------------------------------------------------------*)
- (* Save current SS:SP and BP *)
- (*-----------------------------------------------------------------------*)
-
- ASM;
- MOV set_bp,BP
- END;
-
- WITH active_tcb^ DO
- BEGIN;
- sseg_value := SSEG;
- sptr_value := SPTR;
- bptr_value := set_bp;
- END;
-
- (*-----------------------------------------------------------------------*)
- (* Switch tasks *)
- (*-----------------------------------------------------------------------*)
-
- IF shutdown_switch OR main_switch THEN
- BEGIN;
- active_tcb := main_tcb;
- main_switch := FALSE;
- END
- ELSE
- active_tcb := active_tcb^.next_tcb;
-
- active_port := active_tcb^.tcb_port;
-
- (*-----------------------------------------------------------------------*)
- (* Restore SS:SP and BP *)
- (*-----------------------------------------------------------------------*)
-
- WITH active_tcb^ DO
- BEGIN;
- set_ss := sseg_value;
- set_sp := sptr_value;
- set_bp := bptr_value;
- ASM;
- CLI
- MOV SS,set_ss
- MOV SP,set_sp
- MOV BP,set_bp
- STI
- END;
- END;
-
- (*-----------------------------------------------------------------------*)
- (* Show switch to *)
- (*-----------------------------------------------------------------------*)
-
- {$IFDEF taskdebug}
- WRITELN;
- WRITELN('To');
- WRITELN('STACK = ',pw2x(SSEG, SPTR));
- WRITELN('DSEG = ',w2x(DSEG));
- WRITELN('PREFIX = ',w2x(PREFIXSEG));
- WRITELN('BPTR = ',a2x(set_bp));
- {$ENDIF}
-
- IF LO(signal_place^) < ORD('a') THEN
- signal_place^ := active_tcb^.tcb_number + ORD('a') - 1 + $7800
- ELSE
- signal_place^ := active_tcb^.tcb_number + ORD('A') - 1 + $7800;
-
- (*-----------------------------------------------------------------------*)
- (* Restore the new task's overlay stuff. *)
- (*-----------------------------------------------------------------------*)
-
- IF NOT active_tcb^.tcb_no_overlay THEN
- overlay_restore;
-
- (*-----------------------------------------------------------------------*)
- (* We now exit using the new task's stack *)
- (*-----------------------------------------------------------------------*)
-
- END;
-
- END.